R Notebook

17 October review

New Data review : “C:\20251016scholars.Rda”

Data Prep Work

Clear data

Load Functions

library(readxl)
library(selenider)
library(rvest)
library(tidyverse)
library(netstat)
library(pingr)
library(jsonlite)
library(stringr)
library(openalexR)
library(readxl)

packages <- c("tidyverse", "scholar", "openalexR", "rvest", "jsonlite")
packages <- c("devtools", "igraph")

fpackage.check <- function(packages) {
    lapply(packages, FUN = function(x) {
        if (!require(x, character.only = TRUE)) {
            install.packages(x, dependencies = TRUE)
            library(x, character.only = TRUE)
        }
    })
}

fsave <- function(x, file = NULL, location = "./data/processed/") {
    ifelse(!dir.exists("data"), dir.create("data"), FALSE)
    ifelse(!dir.exists("data/processed"), dir.create("data/processed"), FALSE)
    if (is.null(file))
        file = deparse(substitute(x))
    datename <- substr(gsub("[:-]", "", Sys.time()), 1, 8)
    totalname <- paste(location, file, "_", datename, ".rda", sep = "")
    save(x, file = totalname)  #need to fix if file is reloaded as input name, not as x. 
}

fload <- function(filename) {
    load(filename)
    get(ls()[ls() != "filename"])
}

fshowdf <- function(x, ...) {
    knitr::kable(x, digits = 2, "html", ...) %>%
        kableExtra::kable_styling(bootstrap_options = c("striped", "hover")) %>%
        kableExtra::scroll_box(width = "100%", height = "300px")
}

Access large data file of professors, set of egos for research

Load Dataset - new dataset from Jos

scholars <- fload("C:/Github/labjournal/20251016scholars.Rda") 

New fcolnet function

Define Network Data Helper Function

fcolnet = function(data = scholars, university = c("RU", 'UU'), discipline = "Sociologie", waves = list(c(2015,
    2018), c(2019, 2023), c(2024, 2025)), type = c("first")) {

    university = paste0('(', paste0(university, collapse='|' ), ')')
    discipline = paste0('(', paste0(discipline, collapse='|' ), ')')

    # step 1
    demographics = data$demographics
    sample = which(
        (str_detect(demographics$universiteit.22, university)
            | str_detect(demographics$universiteit.24, university)
            | str_detect(demographics$universiteit.25, university)
        ) & (
            str_detect(demographics$discipline.22, discipline)
            | str_detect(demographics$discipline.24, discipline)
            | str_detect(demographics$discipline.25, discipline)
        ) |> replace_na(FALSE))

    demographics_soc = demographics[sample, ] |> drop_na(id)

    # step 2
    ids = demographics_soc$id |> unique()

    scholars_sel = list() 
    for (id_ in ids){
        scholars_sel[[id_]] = bind_rows(scholars$works) |>
            filter(author_id == id_)
    }
    scholars_sel = bind_rows(scholars$works) 
    

    nwaves = length(waves)
    nets = array(0, dim = c(nwaves, length(ids), length(ids)), dimnames = list(wave = 1:nwaves, ids,
        ids))
    dimnames(nets)

    # step 3
    df_works = tibble(
            works_id = scholars_sel$id, 
            works_author = scholars_sel$authorships, 
            works_year = scholars_sel$publication_year
        )

    df_works = df_works[!duplicated(df_works), ]

    # step 4
    if (type == "first") {
        for (j in 1:length(waves)) {
            df_works_w = df_works[df_works$works_year >= waves[[j]][1] & df_works$works_year <= waves[[j]][2],
                ]
            for (i in 1:nrow(df_works_w)) {
                ego = df_works_w$works_author[i][[1]]$id[1]
                alters = df_works_w$works_author[i][[1]]$id[-1]
                if (sum(ids %in% ego) > 0 & sum(ids %in% alters) > 0) {
                  nets[j, which(ids %in% ego), which(ids %in% alters)] = 1
                }
            }
        }
    }

    if (type == "last") {
        for (j in 1:length(waves)) {
            df_works_w = df_works[df_works$works_year >= waves[[j]][1] & df_works$works_year <= waves[[j]][2],
                ]
            for (i in 1:nrow(df_works_w)) {
                ego = rev(df_works_w$works_author[i][[1]]$id[1])
                alters = rev(df_works_w$works_author[i][[1]]$id[-1])
                if (sum(ids %in% ego) > 0 & sum(ids %in% alters) > 0) {
                  nets[j, which(ids %in% ego), which(ids %in% alters)] = 1
                }
            }
        }
    }
    if (type == "all") {
        for (j in 1:length(waves)) {
            df_works_w = df_works[df_works$works_year >= waves[[j]][1] & df_works$works_year <= waves[[j]][2],
                ]
            for (i in 1:nrow(df_works_w)) {
                egos = df_works_w$works_author[i][[1]]$id
                if (sum(ids %in% egos) > 0) {
                  nets[j, which(ids %in% egos), which(ids %in% egos)] = 1
                }
            }
            diag(nets[j,,]) = 0
        }
    }

    output = list()
    output$data = demographics_soc
    output$nets = nets
    return(output)
}

load Rsiena packages

packages = c(
    "RSiena", "tidyverse",
    'dplyr', 'stringr' # these packages were added to make the code run
)
fpackage.check(packages)

[[1]]
NULL

[[2]]
NULL

[[3]]
NULL

[[4]]
NULL

Getting Data

Application

Load Data

# from Jos code - Radboud and Utrecht
test1 = fcolnet(scholars, university = c('RU', 'UU')) 
df_ego1 = bind_rows(test1$data)

# Radboud only (where I want to start)
test = fcolnet(scholars, university = c("RU")) #only Radboud 
df_ego = bind_rows(test$data)

Wrangle Data

wave1 = test$nets[1,,]
wave2 = test$nets[2,,]
wave3 = test$nets[3,,]

nets = array(
    data = c(wave1, wave2, wave3),
    dim = c(dim(wave2), 2)
)

net = sienaDependent(nets)

Isolate Gender variable (binary)

# Example from recoding function
#df_ego = df_ego |>
#    mutate(
#        funcs = case_when(
#            functie.22 == "Full Professor" ~ 1,
#            functie.24 == "Full Professor" ~ 1,
#            functie.25 == "Full Professor" ~ 1,
#            .default = 0
#        )
#    )

# Recoding for gender
df_ego = df_ego |>
    mutate(
        female = case_when(
            gender == "female" ~ 1,
            .default = 0
        )
    )
female = coCovar(df_ego$female)

Visualizing RU Waves

# make adjacency matrix with first wave of data
test_wave1ru <- igraph::graph_from_adjacency_matrix(
  test$nets[1,,], #for this example I take the first wave of data. (thus I select the array of networks and take the first matrix)
  mode = c("directed"),
  weighted = NULL,
  diag = FALSE,
  add.colnames = NULL,
  add.rownames = NULL
)

#plot to see if it worked 
plot(test_wave1ru,
  vertex.color = ifelse(df_ego$female == 1, "red", "blue"),
  vertex.label = NA,
  edge.width = 0.2,
  edge.arrow.size =0.2)

dim(test_wave1ru) #check it works 

NULL

sum(is.na(test_wave1ru)) #check it is complete -- if 0 missing values

[1] 0

Visualizing just radboud (both depts) wave 2

test_wave2ru <- igraph::graph_from_adjacency_matrix(
  test$nets[2,,], #for this example I take the first wave of data. (thus I select the array of networks and take the first matrix)
  mode = c("directed"),
  weighted = NULL,
  diag = FALSE,
  add.colnames = NULL,
  add.rownames = NULL
)

#plot to see if it worked 
plot(test_wave2ru,
  vertex.color = ifelse(df_ego$female == 1, "red", "blue"),
  vertex.label = NA,
  edge.width = 0.2,
  edge.arrow.size =0.2)

test_wave3ru <- igraph::graph_from_adjacency_matrix(
  test$nets[3,,], #for this example I take the first wave of data. (thus I select the array of networks and take the first matrix)
  mode = c("directed"),
  weighted = NULL,
  diag = FALSE,
  add.colnames = NULL,
  add.rownames = NULL
)

#plot to see if it worked 
plot(test_wave3ru,
  vertex.color = ifelse(df_ego$female == 1, "red", "blue"),
  vertex.label = NA,
  edge.width = 0.2,
  edge.arrow.size =0.2)

Add in collaborators + their gender?

Descriptive Statistics

NOW - LOOK AT DESCRIPTIVE STATISTICS FOR RU ONLY

igraph::transitivity(test_wave3ru, type = c("localundirected"), isolates = c("NaN", "zero"))

https://openalex.org/A5025020830 https://openalex.org/A5107108074 https://openalex.org/A5062356007 https://openalex.org/A5011326378 
                             NaN                              NaN                              NaN                              NaN 
https://openalex.org/A5055990297 https://openalex.org/A5040086999 https://openalex.org/A5010764981 https://openalex.org/A5042713882 
                      0.04761905                              NaN                       0.00000000                              NaN 
https://openalex.org/A5093927073 https://openalex.org/A5047911137 https://openalex.org/A5072634827 https://openalex.org/A5116748350 
                      1.00000000                              NaN                              NaN                       0.00000000 
https://openalex.org/A5046746723 https://openalex.org/A5085082439 https://openalex.org/A5004797389 https://openalex.org/A5059244275 
                      0.66666667                              NaN                              NaN                              NaN 
https://openalex.org/A5063338887 https://openalex.org/A5107698575 https://openalex.org/A5038364313 https://openalex.org/A5071959536 
                             NaN                              NaN                       0.00000000                              NaN 
https://openalex.org/A5083298960 https://openalex.org/A5025639524 https://openalex.org/A5030685996 https://openalex.org/A5037616102 
                             NaN                              NaN                       0.00000000                              NaN 
https://openalex.org/A5002770121 https://openalex.org/A5060194739 https://openalex.org/A5056184618 https://openalex.org/A5104227161 
                             NaN                              NaN                       0.00000000                              NaN 
https://openalex.org/A5048074496 https://openalex.org/A5062173114 https://openalex.org/A5058254351 https://openalex.org/A5099033606 
                      0.00000000                              NaN                       0.00000000                              NaN 
https://openalex.org/A5056774186 https://openalex.org/A5084918963 https://openalex.org/A5047687982 https://openalex.org/A5066699568 
                             NaN                              NaN                              NaN                       0.00000000 
https://openalex.org/A5043015269 https://openalex.org/A5029360150 https://openalex.org/A5045280782 https://openalex.org/A5030658869 
                      0.00000000                              NaN                              NaN                              NaN 
https://openalex.org/A5056557463 https://openalex.org/A5024195666 https://openalex.org/A5103523883 https://openalex.org/A5093330363 
                             NaN                              NaN                              NaN                              NaN 
https://openalex.org/A5085123027 https://openalex.org/A5035350135 https://openalex.org/A5086908160 https://openalex.org/A5026623706 
                             NaN                       0.16666667                       0.00000000                       0.00000000 
https://openalex.org/A5102070907 https://openalex.org/A5068642001 https://openalex.org/A5075816665 https://openalex.org/A5104078567 
                             NaN                              NaN                              NaN                              NaN 
https://openalex.org/A5064646891 https://openalex.org/A5075710125 https://openalex.org/A5048218319 https://openalex.org/A5037423746 
                             NaN                              NaN                              NaN                              NaN 
https://openalex.org/A5040385638 https://openalex.org/A5080235042 https://openalex.org/A5038009917 https://openalex.org/A5081499440 
                             NaN                              NaN                              NaN                              NaN 
https://openalex.org/A5050680074 https://openalex.org/A5058115048 https://openalex.org/A5100375099 https://openalex.org/A5087380803 
                             NaN                              NaN                              NaN                       0.30000000 
https://openalex.org/A5065325810 https://openalex.org/A5041095675 https://openalex.org/A5017382943 https://openalex.org/A5050786452 
                      1.00000000                              NaN                              NaN                              NaN 
https://openalex.org/A5023395007 https://openalex.org/A5055096981 https://openalex.org/A5016089551 https://openalex.org/A5091348904 
                             NaN                       0.00000000                              NaN                              NaN 
https://openalex.org/A5031002485 https://openalex.org/A5042331969 https://openalex.org/A5066092617 https://openalex.org/A5017636151 
                      0.00000000                              NaN                              NaN                              NaN 
https://openalex.org/A5017637321 https://openalex.org/A5082749336 https://openalex.org/A5018242597 https://openalex.org/A5080593921 
                             NaN                              NaN                              NaN                              NaN 
https://openalex.org/A5053506252 https://openalex.org/A5074062335 https://openalex.org/A5038843493 https://openalex.org/A5019799886 
                             NaN                              NaN                       0.33333333                              NaN 
https://openalex.org/A5023362052 https://openalex.org/A5085493990 https://openalex.org/A5048125830 https://openalex.org/A5003892082 
                             NaN                              NaN                              NaN                       0.00000000 
https://openalex.org/A5002388922 https://openalex.org/A5064349318 https://openalex.org/A5018212005 https://openalex.org/A5112383954 
                             NaN                              NaN                       0.00000000                              NaN 
https://openalex.org/A5038425122 https://openalex.org/A5019957971 https://openalex.org/A5040600354 https://openalex.org/A5037069958 
                             NaN                              NaN                       0.00000000                       1.00000000 
https://openalex.org/A5060015711 https://openalex.org/A5020765315 https://openalex.org/A5095856216 https://openalex.org/A5082048045 
                      0.33333333                              NaN                              NaN                              NaN 
https://openalex.org/A5007673492 https://openalex.org/A5043004626 https://openalex.org/A5025668614 https://openalex.org/A5048988743 
                             NaN                              NaN                              NaN                       0.00000000 
https://openalex.org/A5078173090 https://openalex.org/A5009655338 https://openalex.org/A5004733423 https://openalex.org/A5016107698 
                             NaN                       1.00000000                              NaN                       0.00000000 
https://openalex.org/A5035502020 https://openalex.org/A5050683616 https://openalex.org/A5006416152 https://openalex.org/A5112742337 
                      0.10000000                              NaN                              NaN                              NaN 
https://openalex.org/A5012137641 https://openalex.org/A5030092568 https://openalex.org/A5012273953 https://openalex.org/A5023494442 
                             NaN                              NaN                       0.00000000                              NaN 
https://openalex.org/A5031371982 https://openalex.org/A5068000059 https://openalex.org/A5032041950 https://openalex.org/A5017129862 
                      0.00000000                              NaN                       0.00000000                              NaN 
https://openalex.org/A5030977100 https://openalex.org/A5063497971 https://openalex.org/A5102793963 https://openalex.org/A5018479981 
                             NaN                       0.00000000                              NaN                              NaN 
https://openalex.org/A5079372810 https://openalex.org/A5020071821 https://openalex.org/A5017879057 https://openalex.org/A5013258554 
                             NaN                              NaN                              NaN                       0.00000000 
https://openalex.org/A5002265802 https://openalex.org/A5006081433 https://openalex.org/A5021227718 https://openalex.org/A5065130106 
                             NaN                              NaN                              NaN                       0.00000000 
https://openalex.org/A5062608377 https://openalex.org/A5068892781 https://openalex.org/A5045288860 https://openalex.org/A5085013298 
                      0.00000000                              NaN                              NaN                       0.33333333 
https://openalex.org/A5061402160 https://openalex.org/A5078518573 https://openalex.org/A5046585291 https://openalex.org/A5019204497 
                             NaN                              NaN                              NaN                       0.00000000 
https://openalex.org/A5087435392 https://openalex.org/A5042405723 https://openalex.org/A5001803910 https://openalex.org/A5044445824 
                             NaN                              NaN                       0.33333333                              NaN 
https://openalex.org/A5081620696 https://openalex.org/A5066781342 https://openalex.org/A5057934803 https://openalex.org/A5033572980 
                      0.00000000                              NaN                              NaN                              NaN 
https://openalex.org/A5084821293 https://openalex.org/A5039921154 https://openalex.org/A5008459416 https://openalex.org/A5022243966 
                      0.00000000                              NaN                              NaN                       0.33333333 
https://openalex.org/A5065278343 https://openalex.org/A5074532622 https://openalex.org/A5113457866 https://openalex.org/A5059043231 
                             NaN                              NaN                              NaN                              NaN 
https://openalex.org/A5013379944 https://openalex.org/A5000347656 https://openalex.org/A5026156805 https://openalex.org/A5064944446 
                      0.00000000                       0.00000000                              NaN                              NaN 

Next, moving from local to global transitivity

• Look at triads for more global transitivity.
• Note: Global = number of observed over possible - can identify all transitive triads and all possible triads
• Reviewing dyads - then triads. Since it is undirected, it is less difficult to calculate.
• Now, looking at triad census vs triad allegation

igraph::triad.census(test_wave3ru) #with plot -- works

 [1] 658675  10658    462     28     68     13      8      2      5      0      0      0      0      0      1      0

sna::triad.census(test$nets[2,,])

        003   012  102 021D 021U 021C 111D 111U 030T 030C 201 120D 120U 120C 210 300
[1,] 650587 16986 1963   37  189   58   56   10   14    0   1    8    4    4   2   1

unloadNamespace("sna")  #I will detach this package again

triad_w2ru <- data.frame(sna::triad.census(test$nets[2,,])) #save as df


igraph::transitivity(test_wave2ru, type = "global")

[1] 0.22

  # Returns: [1] 0.22
sna::gtrans(test$nets[2,,]) #triad census a different way 

[1] 0.2842105

  # Returns: [1] 0.2842105

transitivity_w2 <- (3 * triad_w2ru$X300)/(triad_w2ru$X201 + 3 * triad_w2ru$X300) #X300 is variable for transitive triad (the fully closed triad)
# we multiply by 3 because there are 3 possible transitive triads
transitivity_w2

[1] 0.75

  # Returns: [1] 0.75



# Wave 3
sna::triad.census(test$nets[3,,])

        003   012 102 021D 021U 021C 111D 111U 030T 030C 201 120D 120U 120C 210 300
[1,] 658675 10658 462   28   68   13    8    2    5    0   0    0    0    0   1   0

   # Returns: 003    012   102   021D  021U  021C  111D  111U  030T  030C 201  120D  120U 120C  210  300
   #    [1,]  658675 10658 462   28    68    13     8     2     5    0    0    0     0     0     1   0

unloadNamespace("sna")  #I will detach this package again

triad_w3ru <- data.frame(sna::triad.census(test$nets[3,,])) #save as df


igraph::transitivity(test_wave3ru, type = "global")

[1] 0.1313869

  # Returns: [1] 0.1313869
sna::gtrans(test$nets[3,,]) #triad census a different way 

[1] 0.25

  # Returns: [1] 0.25

transitivity_w3 <- (3 * triad_w3ru$X300)/(triad_w3ru$X201 + 3 * triad_w3ru$X300) #X300 is variable for transitive triad (the fully closed triad)
# we multiply by 3 because there are 3 possible transitive triads
transitivity_w3

[1] NaN

  # Returns: [1] NaN

NEED TO INCLUDE TRIADS - TRANSITIVITY OUTDEGREE AND RECIPROCITY ARE ALWAYS IN THERE, ALSO NEED OUTDEGREE ACTIVITY OR IN DEGREE POPULARITY. ALSO NEED SOMETHING FOR TRANSITIVITY - GWESP VARIABLE AND EFFECTS TO INCLUDE - MAKE SURE TO INCLUDE ONE OF THESE TOO.

Network visualisation: Let’s make size proportional to betweenness score

Rsiena work

Get packages: Jochem’s twostep

fpackage.check(packages)

[[1]]
NULL

Step 1: Define data

Independent variable: gender?

We already know: net <- sienaDependent(nets) (dependent variable) Dependent variable: ties = [net]

mydata <- sienaDataCreate(net, gender) #buggy - why doesnt this work?? 

Error in sienaDataCreate(net, gender) : 
  constant covariate incorrect node set: gender

Step 2. Look at effects

effectsDocumentation(myeff)

Step 3: Look at intial data

• good for deciding statistics to use.

print01Report(mydata)

# gives initial description of data 
# reading network variables , covariates, density measures/changes in networks, tie changes between subsequent observations... calculate how much networks changed over time. 
# dont use balance calculation 

Step 4: Add effects

Example:

net1g <- graph_from_adjacency_matrix(ts_net1, mode = "directed")
coords <- layout_(net1g, nicely())  #let us keep the layout
par(mar = c(0.1, 0.1, 0.1, 0.1))
{
    plot.igraph(net1g, layout = coords)
    graphics::box()
}

# for every actor, there are 10 options - each actor can break tie, keep tie/do nothing, or add new tie. If tie, can break or keep. If there is no tie, can remain 0 tie or form a tie. 


# Now, select 'random' agent: 
set.seed(24553253)
ego <- ts_select(net = ts_net1)
ego


#### Network: ts_net1, ego = ego4 (ego 4 allowed to make ministeps). package then will list all of the different adjacency matrices. Shows all of the different next ministep options for ego 4. 


#### 
options <- ts_alternatives_ministep(net = ts_net1, ego = ego)
options

plots <- lapply(options, graph_from_adjacency_matrix, mode = "directed")
par(mar = c(0, 0, 0, 0) + 0.1)
par(mfrow = c(2, 2))

fplot <- function(x) {
    plot.igraph(x, layout = coords, margin = 0)
    graphics::box()
}


ts_degree(net = options[[1]], ego = ego)
sapply(options, ts_degree, ego = ego)

IF NEEDED LATER:

Now, try to loop in gender

Make simple adj matrix for gender